PD ROM 1/PD ROM Volume I - Macintosh Software from BMUG (1988).iso/Graphics/Graphic Demos/Stair Draw/source/Stair_Program

Text File | 1987-01-18 | 19.0 KB | 895 lines | [TEXT/PJMM]

{** STAIR PROGRAM **}
{Program to layout and draw stair section    }
{Version 0.90     01/18/87      G. Langdon    }

{**   WINDOWS, MENUS, DIALOGS, & STAIR ROUTINES   **    }
{This unit does the following:                                    }
{    1.    Initializes the Window, Menus,  Controls & Dialogs.     }
{    2.    Sets their default values.                                }
{    3.    Calculates the stair components.                        }
{    4.    Determines whether stair is to be layed out in         }
{        a straight or U-type run.                                 }
{    5.    Draws the stair section in the window.                    }
{    6.  Saves the stair drawing in PICT format on default        }
{        volume.                                                    }

UNIT Stair_Program;

INTERFACE

  {Use the global constants, types and variables...}
    USES
        Stair_Globals;

   {Low level initialization routines...}
    PROCEDURE SetUpMenus;
    PROCEDURE SetUpWindow;
    PROCEDURE SetDefaults;
    PROCEDURE UpdateSys;


   {Routines to convert between number types...}
    PROCEDURE ConvertToExtended (theAns : Str255;
                                    VAR theNum : Extended);
    PROCEDURE ConvertToLongint (theNum : Extended;
                                    VAR theLongint : Longint);

  {Routines to calculate layout of stair...}
    PROCEDURE CalcTotHt;
    PROCEDURE CalcRisers;
    PROCEDURE CalcTreads;

   {Routines to display layout calculations in the window...}
    PROCEDURE WriteStr (h, v : INTEGER;
                                    theStr : Str255);
    PROCEDURE WriteNum (h, v : INTEGER;
                                    theNum : Extended);
    PROCEDURE DisplayInfo;

   {Routines to draw the stair section...}
    PROCEDURE GetTheStair (VAR StairType : INTEGER);
    FUNCTION ConvertToPixels (theDim : Extended) : INTEGER;
    PROCEDURE DrawTopLanding (StairType : INTEGER);
    PROCEDURE DrawMidLanding (StairType : INTEGER);
    PROCEDURE DrawBtmLanding (StairType : INTEGER);
    PROCEDURE DrawTopRun (StairType : INTEGER);
    PROCEDURE DrawBtmRun (StairType : INTEGER);
    PROCEDURE DrawStair;


  {Routines to implement the dialog...}
    FUNCTION CtlHdl (theItem : INTEGER) : ControlHandle;
    PROCEDURE SetUpDialog;
    PROCEDURE SetRadBtn (theItem : INTEGER);
    PROCEDURE UpdateDefaults;
    PROCEDURE DoDialog;
    PROCEDURE RunDialog;

   {Routines to implement the window and its actions...}
    PROCEDURE GetPict;
    PROCEDURE UpdatePic (theWindow : WindowPtr;
                                    URgn : RgnHandle);
    PROCEDURE SavePic;
    PROCEDURE ScrAction (theCtl : ControlHandle;
                                    partCode : INTEGER);
    PROCEDURE WindowScroll (theWindow : WindowPtr;
                                    thePt : Point);
    PROCEDURE WindowGrow (theWindow : WindowPtr);
    PROCEDURE DoGoAway (theWindow : WindowPtr);
    PROCEDURE WindowUpdate (theWindow : WindowPtr);

   {Routines to implement the menus and their actions...}
    PROCEDURE QuitFile;
    PROCEDURE ClearWindow;
    PROCEDURE DoAppleMenu (theItem : INTEGER);
    PROCEDURE DoFileMenu (theItem : INTEGER);
    PROCEDURE DoEditMenu (theItem : INTEGER);
    PROCEDURE DoScaleMenu (theItem : INTEGER);
    PROCEDURE DoPenMenu (theItem : INTEGER);
    PROCEDURE SelectMenu (selection : LongInt);
    PROCEDURE KeyEvent (theKey : Char);

  {Setup the overall system...}
    PROCEDURE SetUpSys;


IMPLEMENTATION

{**** BEGINNING OF STAIR PROGRAM ****}

    PROCEDURE SetUpMenus;
        VAR
            I : INTEGER;
    BEGIN
          {Open menu resources...}
        InitMenus;
         {Assign menu handles to menu array...}
        theMenus[1] := GetMenu(AppleMenu);
        theMenus[2] := GetMenu(FileMenu);
        theMenus[3] := GetMenu(EditMenu);
        theMenus[4] := GetMenu(ScaleMenu);
        theMenus[5] := GetMenu(PenMenu);
         {Add Desk Accessories to AppleMenu...}
        AddResMenu(theMenus[1], 'DRVR');
        FOR I := 1 TO lastMenu DO
            InsertMenu(theMenus[I], 0);
        {Draw the menu titles in the menu bar...}
        DrawMenuBar;
    END;

    PROCEDURE SetUpWindow;
    BEGIN
       {Open resource file defining the drawing window...            }
       {Define region and rectangles for use with the window...    }
        DrawWindow := GetNewWindow(256, NIL, POINTER(-1));
        vsBar := GetNewControl(258, DrawWindow);
        HiliteControl(vsBar, 255);
        hsBar := GetNewControl(257, DrawWindow);
        HiliteControl(hsBar, 255);
        URgn := NewRgn;
        SetRect(PicBnds, 0, 0, 662, 442);
        SetRect(SizeBnds, 50, 50, 512, 342);
        SetRect(DragBnds, 4, 24, 508, 338);
    END;

    PROCEDURE SetDefaults;
    BEGIN
       {Set initial value of pixels per inch...}
        pixelIn := 1.58333;
       {Set initial value of drawing pen...}
        penWidth := 1;
        penHeight := 1;
       {Set initial values for dialog items...}
        FtAns := '';
        InAns := '';
        RGroup[1].min := StrtBtn;
        RGroup[1].max := UTypeBtn;
        RGroup[1].default := UTypeBtn;
        RGroup[2].min := TopBtn;
        RGroup[2].max := BtmBtn;
        RGroup[2].default := BtmBtn;
    END;

    PROCEDURE UpdateSys;
    BEGIN
        SystemTask;
    END;

    PROCEDURE ConvertToExtended;
        VAR
            longNum : Longint;
            logNum : extended;
    BEGIN
        {Check that a decimal numer was not entered...}
        IF pos('.', theAns) = 0 THEN
            BEGIN
            {Convert the answer string to a longint number...}
                StringToNum(theAns, longNum);
            {Convert the longint to an number of type extended...}
                logNum := exp(longNum);
                theNum := ln(logNum);
            END
        ELSE
            theItem := CautionAlert(1002, NIL);
    END;

    PROCEDURE ConvertToLongint;
    BEGIN
    {Convert the extended number to a number of type Longint...}
        theLongint := round(theNum);
    END;

    PROCEDURE CalcTotHt;
    BEGIN
        ConvertToExtended(FtAns, Feet);
        ConvertToExtended(InAns, Inches);
        Ht := (Feet * 12.00) + Inches;
    END;

    PROCEDURE CalcRisers;
    BEGIN
        Risers := Ht / StdRiser;
        AdjRisers := round(Risers) + 1;
        RiserDim := Ht / AdjRisers;
    END;

    PROCEDURE CalcTreads;
    BEGIN
        Treads := adjRisers - 1;
        IF (RiserDim < 5.99) THEN
            TreadDim := 12.00;
        IF (RiserDim >= 6.00) AND (RiserDim <= 6.99) THEN
            TreadDim := 11.50;
        IF (RiserDim >= 7.00) AND (RiserDim <= 7.12) THEN
            TreadDim := 11.00;
        IF (RiserDim >= 7.13) AND (RiserDim <= 7.24) THEN
            TreadDim := 10.75;
        IF (RiserDim >= 7.25) AND (RiserDim <= 7.37) THEN
            TreadDim := 10.50;
        IF (RiserDim >= 7.38) AND (RiserDim <= 7.49) THEN
            TreadDim := 10.25;
        IF (RiserDim >= 7.5) THEN
            TreadDim := 10.00;
    END;

    PROCEDURE GetTheStair;
        VAR
            StairShape, LongerAt : INTEGER;
    BEGIN
        StairShape := SelectedCtl[1].value;
        LongerAt := SelectedCtl[2].value;
        CASE StairShape OF
            UTypeBtn :
                IF (AdjRisers MOD 2 = 0) THEN
                    BEGIN
                        StairType := 1;
                    END
                ELSE
                    BEGIN
                        CASE LongerAt OF
                            BtmBtn :
                                StairType := 2;
                            TopBtn :
                                StairType := 3;
                        END;
                    END;
            StrtBtn :
                BEGIN
                    IF Ht < 144 THEN
                        StairType := 4
                    ELSE
                        BEGIN
                            IF (AdjRisers MOD 2 = 0) THEN
                                BEGIN
                                    StairType := 5;
                                END
                            ELSE
                                BEGIN
                                    CASE LongerAt OF
                                        BtmBtn :
                                            StairType := 6;
                                        TopBtn :
                                            StairType := 7;
                                    END;
                                END;
                        END;
                END;
            OTHERWISE
                ;
        END;
    END;

    FUNCTION ConvertToPixels;
    BEGIN
        ConvertToPixels := round(theDim * pixelIn);
    END;

    PROCEDURE DrawTopLanding;
        VAR
            Landing, Tread : INTEGER;
    BEGIN
        Landing := ConvertToPixels(LandingDim);
        Tread := ConvertToPixels(TreadDim);
        CASE StairType OF
            1, 2, 3, 4, 5, 6, 7 :
                line((Landing - Tread), 0);
            OTHERWISE
                ;
        END;
    END;

    PROCEDURE DrawTopRun;
        VAR
            Riser, Tread, Nosing, Steps, Run : INTEGER;
    BEGIN
        Riser := ConvertToPixels(RiserDim);
        Tread := ConvertToPixels(TreadDim);
        Nosing := ConvertToPixels(NosingDim);
        CASE StairType OF
            1, 2, 5, 6 :   {Even number of risers with equal stair runs}
                Run := (AdjRisers DIV 2);
            3, 7 :           {Odd number of risers with longer stair run at top}
                Run := (AdjRisers DIV 2) + 1;
            4 :                {Stair less than 12 ft, so only one stair run}
                Run := AdjRisers;
            OTHERWISE
                ;
        END;
        CASE StairType OF
            1, 2, 3, 4, 5, 6, 7 :    {Draw stair run to right for all cases}
                BEGIN
                    FOR Steps := 1 TO Run DO
                        BEGIN
                            line(Tread, 0);
                            line(0, Nosing);
                            line(-Nosing, 0);
                            line(0, (Riser - Nosing));
                        END;
                END;
            OTHERWISE
                ;
        END;
    END;

    PROCEDURE DrawMidLanding;
        VAR
            Landing, Tread, Nosing : INTEGER;
    BEGIN
        Landing := ConvertToPixels(LandingDim);
        Tread := ConvertToPixels(TreadDim);
        Nosing := ConvertToPixels(NosingDim);
        CASE StairType OF
            1, 2, 3 :    {Draw landing to right then return to left}
                BEGIN
                    line(Landing, 0);
                    line(-(Landing - Tread + Nosing), 0);
                END;
            4 :
                ;             {Stair less than 12 ft so no middle landing}
            5, 6, 7 :    {Draw landing to right, just like Top Landing}
                DrawTopLanding(1);
            OTHERWISE
                ;
        END;
    END;

    PROCEDURE DrawBtmRun;
        VAR
            Riser, Tread, Nosing, Steps, Run : INTEGER;
    BEGIN
        Riser := ConvertToPixels(RiserDim);
        Tread := ConvertToPixels(TreadDim);
        Nosing := ConvertToPixels(NosingDim);
        CASE StairType OF
            1, 3, 5, 7 :   {Even number of risers with equal stair runs}
                Run := (AdjRisers DIV 2);
            2, 6 :       {Odd number of risers with longer stair run at bottom}
                Run := (AdjRisers DIV 2) + 1;
            4 :
                ;                {Stair less than 12 ft so no bottom run}
            OTHERWISE
                ;
        END;
        CASE StairType OF
            1, 2, 3 :    {Draw stair run to left for U-type stairs}
                BEGIN
                    FOR Steps := 1 TO Run DO
                        BEGIN
                            line(-Tread, 0);
                            line(0, Nosing);
                            line(Nosing, 0);
                            line(0, (Riser - Nosing));
                        END;
                END;
            5, 6, 7 :     {Draw stair run to right for straight stairs}
                BEGIN
                    FOR Steps := 1 TO Run DO
                        BEGIN
                            line(Tread, 0);
                            line(0, Nosing);
                            line(-Nosing, 0);
                            line(0, (Riser - Nosing));
                        END;
                END;
            4 :
                ;              {Stair less than 12 ft so no bottom run}
            OTHERWISE
                ;
        END;
    END;

    PROCEDURE DrawBtmLanding;
        VAR
            Landing : INTEGER;
    BEGIN
        Landing := ConvertToPixels(LandingDim);
        CASE StairType OF
            1, 2, 3 :        {Draw landing to the left for U-type stairs}
                BEGIN
                    line(-Landing, 0);
                END;
            4, 5, 6, 7 :   {Draw landing to the right for straight stairs}
                BEGIN
                    line(Landing, 0);
                END;
            OTHERWISE
                ;
        END;
    END;

    PROCEDURE DrawStair;
    BEGIN
        IF Ht <> 0 THEN
            BEGIN
                SetPort(DrawWindow);
                PenSize(penWidth, penHeight);
                GettheStair(StairType);
                MoveTo(10, 10);
                DrawTopLanding(StairType);
                DrawTopRun(StairType);
                DrawMidLanding(StairType);
                DrawBtmRun(StairType);
                DrawBtmLanding(StairType);
                PenNormal;
            END
        ELSE
    END;

    PROCEDURE WriteStr;
    BEGIN
        Moveto(h, v);
        DrawString(theStr);
    END;

    PROCEDURE WriteNum;
    BEGIN
        MoveTo(h, v);
        WriteDraw(theNum : 5 : 2);
    END;

    PROCEDURE DisplayInfo;
    BEGIN
        CalcTotHt;
        CalcRisers;
        CalcTreads;
        IF Ht <> 0 THEN
            BEGIN
                WriteStr(300, 20, 'Stair Height:');
                WriteNum(380, 20, Feet);
                WriteStr(415, 20, 'Ft,');
                WriteNum(435, 20, Inches);
                WriteStr(469, 20, 'In');
                WriteStr(300, 35, 'Total Height:');
                WriteNum(380, 35, Ht);
                WriteStr(422, 35, 'In');
                WriteStr(300, 50, 'Total Risers:');
                WriteNum(380, 50, AdjRisers);
                WriteStr(300, 65, 'Riser Height:');
                WriteNum(380, 65, RiserDim);
                WriteStr(412, 65, 'In');
                WriteStr(300, 80, 'Total Treads:');
                WriteNum(380, 80, Treads);
                WriteStr(300, 95, 'Tread Depth:');
                WriteNum(380, 95, TreadDim);
                WriteStr(412, 95, 'In');
            END
        ELSE
    END;

    FUNCTION CtlHdl;
    BEGIN
        GetDItem(theDialog, theItem, theType, ItemHdl, ItemBox);
        CtlHdl := ControlHandle(ItemHdl);
    END;

    PROCEDURE SetUpDialog;
        VAR
            I, J : INTEGER;
    BEGIN
        theDialog := GetNewDialog(1000, NIL, POINTER(-1));
        FOR I := 1 TO numRGroups DO
            FOR J := RGroup[I].min TO RGroup[I].max DO
                BEGIN
                    SetCRefCon(CtlHdl(J), I);
                    SetCtlValue(CtlHdl(J), ORD(J = RGroup[I].default));
                END;
        SetIText(Handle(CtlHdl(FtTxt)), FtAns);
        SetIText(Handle(CtlHdl(InTxt)), InAns);
        SelIText(theDialog, FtTxt, length(FtAns), length(FtAns));
    END;

    PROCEDURE SetRadBtn;
        VAR
            I, J : INTEGER;
    BEGIN
        I := GetCRefCon(CtlHdl(theItem));
        FOR J := RGroup[I].min TO RGroup[I].max DO
            SetCtlValue(CtlHdl(J), ORD(J = theItem));
    END;

    PROCEDURE UpdateDefaults;
        VAR
            I, J : INTEGER;
    BEGIN
        FOR I := 1 TO numRGroups DO
            FOR J := RGroup[I].min TO RGroup[I].max DO
                IF GetCtlValue(CtlHdl(J)) = 1 THEN
                    BEGIN
                        RGroup[I].default := J;
                        SelectedCtl[I].value := J;
                    END;
        GetIText(Handle(CtlHdl(FtTxt)), FtAns);
        GetIText(Handle(CtlHdl(InTxt)), InAns);
    END;

    PROCEDURE DoDialog;
    BEGIN
        FlushEvents(everyEvent, 0);
        REPEAT
            ModalDialog(NIL, itemHit);
            CASE itemHit OF
                StrtBtn :
                    BEGIN
                        SetRadBtn(itemHit);
                    END;
                UTypeBtn :
                    BEGIN
                        SetRadBtn(itemHit);
                    END;
                TopBtn :
                    BEGIN
                        SetRadBtn(itemHit);
                    END;
                BtmBtn :
                    BEGIN
                        SetRadBtn(itemHit);
                    END;
                OTHERWISE
                    ;
            END;
        UNTIL (itemHit = OKBtn) OR (itemHit = CancelBtn);
        IF itemHit = OKBtn THEN
            UpdateDefaults;
        IF itemHit = CancelBtn THEN
            ;
    END;

    PROCEDURE RunDialog;
    BEGIN
        ClearWindow;
        SetUpDialog;
        DoDialog;
        DisposDialog(theDialog);
        IF itemHit = OKBtn THEN
            BEGIN
                GetPict;
                IF NOT FirstDialog THEN
                    UpdatePic(DrawWindow, URgn);
                WindowUpdate(DrawWindow);
            END;
        IF itemHit = CancelBtn THEN
            BEGIN
                GetPict;
                IF NOT FirstDialog THEN
                    UpdatePic(DrawWindow, URgn);
                WindowUpdate(DrawWindow);
            END;
    END;

    PROCEDURE GetPict;
    BEGIN
        SetPort(DrawWindow);
        TextFont(Geneva);
        TextFace([bold]);
        TextSize(9);
        ClipRect(PicBnds);
        Pict := OpenPicture(PicBnds);
        DisplayInfo;
        DrawStair;
        ClosePicture;
    END;

    PROCEDURE UpdatePic;
        VAR
            S : Point;
    BEGIN
        SetPt(S, GetCtlValue(hsBar), GetCtlValue(vsBar));
        SetOrigin(S.h, S.v);
        OffsetRgn(URgn, S.h, S.v);
        SetClip(URgn);
        EraseRgn(URgn);
        Hlock(Handle(Pict));
        DrawPicture(Pict, PicBnds);
        HUnlock(Handle(Pict));
        SetOrigin(0, 0);
        ClipRect(thePort^.portRect);
        DrawControls(theWindow);
    END;

    PROCEDURE SavePic;
        VAR
            theFile : fileName;
    BEGIN
        theItem := CautionAlert(1003, NIL);
        CASE theItem OF
            1 :
                BEGIN
                    theFile := 'Stair Disk:Stair Drawing';
                    SaveDrawing(theFile);
                END;
            2 :
                ;
            OTHERWISE
                ;
        END;
    END;

    PROCEDURE ScrAction;
        VAR
            PageSize, Delta : INTEGER;
            S, dS : Point;
            ViewBnds : Rect;
    BEGIN
        WITH thePort^.portRect DO
            CASE GetCRefCon(theCtl) OF
                1 :
                    PageSize := (right - left - 16) DIV 2;
                2 :
                    PageSize := (bottom - top - 16) DIV 2;
                OTHERWISE
                    ;
            END;
        CASE partCode OF
            inUpButton :
                Delta := -ScrollSize;
            inDownButton :
                Delta := +ScrollSize;
            inPageUp :
                Delta := -PageSize;
            inPageDown :
                Delta := +PageSize;
            OTHERWISE
                ;
        END;
        SetPt(S, GetCtlValue(hsBar), GetCtlValue(vsBar));
        SetCtlValue(theCtl, GetCtlValue(theCtl) + Delta);
        SetPt(dS, S.h - GetCtlValue(hsBar), S.v - GetCtlValue(vsBar));
        WITH thePort^.portRect DO
            SetRect(ViewBnds, left, top, right - 15, bottom - 15);
        ScrollRect(ViewBnds, dS.h, dS.v, URgn);
        UpdatePic(DrawWindow, URgn);
    END;


    PROCEDURE WindowScroll;
        VAR
            theCtl : ControlHandle;
    BEGIN
        IF theWindow = FrontWindow THEN
            BEGIN
                SetPort(theWindow);
                GlobalToLocal(thePt);
                CASE FindControl(thePt, theWindow, theCtl) OF
                    inUpButton, inDownButton, inPageUp, inPageDown :
                        IF TrackControl(theCtl, thePt, @ScrAction) <> 0 THEN
                            ;
                    inThumb :
                        IF TrackControl(theCtl, thePt, NIL) <> 0 THEN
                            BEGIN
                                WITH theWindow^.portRect DO
                                    SetRectRgn(URgn, left, top, right - 15, bottom - 15);
                                UpdatePic(theWindow, URgn);
                            END;
                    OTHERWISE
                        ;
                END;
            END
        ELSE
            BEGIN
                SelectWindow(theWindow);
                DrawGrowIcon(theWindow);
                DrawControls(theWindow);
            END;
    END;

    PROCEDURE WindowGrow;
        VAR
            WSize : Longint;
            S : Point;
    BEGIN
        WSize := GrowWindow(theWindow, theEvent.where, SizeBnds);
        IF WSize <> 0 THEN
            BEGIN
                SetPt(S, LoWord(WSize), HiWord(WSize));
                SizeWindow(theWindow, S.h, S.v, TRUE);
                SetPort(theWindow);
                ClipRect(thePort^.portRect);
                SizeControl(hsBar, S.h - 13, 16);
                MoveControl(hsBar, -1, S.v - 15);
                SizeControl(vsBar, 16, S.v - 13);
                MoveControl(vsBar, S.h - 15, -1);
            END;
    END;

    PROCEDURE DoGoAway;
    BEGIN
        IF theWindow <> FrontWindow THEN
            SelectWindow(theWindow)
        ELSE IF TrackGoAway(theWindow, theEvent.where) THEN
            BEGIN
                IF FrontWindow = theWindow THEN
                    DisposeWindow(theWindow);
            END;
    END;


    PROCEDURE WindowUpdate;
        VAR
            GrowArea : Rect;
    BEGIN
        SetPort(theWindow);
        WITH thePort^.portRect DO
            SetRect(GrowArea, right - 15, bottom - 15, right, bottom);
        InvalRect(GrowArea);
        IF theWindow = FrontWindow THEN
            BEGIN
                HiliteControl(vsBar, 0);
                HiliteControl(hsBar, 0);
                ShowControl(vsBar);
                ShowControl(hsBar);
            END
        ELSE
            BEGIN
                HideControl(vsBar);
                HideControl(hsBar);
            END;
        BeginUpdate(theWindow);
        EraseRect(theWindow^.portRect);
        DrawGrowIcon(theWindow);
        DrawControls(theWindow);
        WITH theWindow^.portRect DO
            SetRectRgn(URgn, left, top, right - 15, bottom - 15);
        UpdatePic(theWindow, URgn);
        EndUpdate(theWindow);
    END;

    PROCEDURE QuitFile;
    BEGIN
        done := TRUE;
    END;

    PROCEDURE ClearWindow;
        VAR
            theScreen : Rect;
    BEGIN
        SetPort(DrawWindow);
        theScreen := thePort^.portRect;
{**EraseRect(theScreen);**}
    END;


    PROCEDURE DoAppleMenu;
        VAR
            refNum : INTEGER;
            name : Str255;
    BEGIN
        IF theItem = 1 THEN
            theItem := Alert(1001, NIL)
        ELSE
            BEGIN
                getItem(theMenus[1], theItem, name);
                refNum := OpenDeskAcc(name);
            END;
    END;

    PROCEDURE DoFileMenu;
    BEGIN
        CASE theItem OF
            1 :
                BEGIN
                    FirstDialog := FALSE;
                    IF FrontWindow <> NIL THEN
                        DisposeWindow(DrawWindow);
                    SetUpWindow;
                    RunDialog;
                END;
            5 :
                SavePic;
            8 :
                QuitFile;
            OTHERWISE
                ;
        END;
    END;

    PROCEDURE DoEditMenu;
    BEGIN
        IF NOT SystemEdit(theItem + 1) THEN
            BEGIN
                SetPort(DrawWindow);
                CASE theItem OF
                    4 :
                        BEGIN
                            ClearWindow;
                        END;
                    OTHERWISE
                        ;
                END;
            END;
    END;

    PROCEDURE DoScaleMenu;
    BEGIN
        CASE theItem OF
            1 :    {Scale 1/8"=1'-0"}
                BEGIN
                    pixelIn := 1.58333;
                END;
            2 :    {Scale 1/4"=1'-0"}
                BEGIN
                    pixelIn := (1.58333 * 2.0);
                END;
            3 :    {Scale 1/2"=1'-0"}
                BEGIN
                    pixelIn := (1.58333 * 4.0);
                END;
            4 :    {Scale 3/4"=1'-0"}
                BEGIN
                    pixelIn := (1.58333 * 6.0);
                END;
            OTHERWISE
                ;
        END;
    END;

    PROCEDURE DoPenMenu;
    BEGIN
        CASE theItem OF
            1 :    {Pen Size = 1 pixel}
                BEGIN
                    penWidth := 1;
                    penHeight := 1;
                END;
            2 :    {Pen Size = 2 pixel}
                BEGIN
                    penWidth := 2;
                    penHeight := 2;
                END;
            3 :     {Pen Size = 3 pixel}
                BEGIN
                    penWidth := 3;
                    penHeight := 3;
                END;
            OTHERWISE
                ;
        END;
    END;

    PROCEDURE SelectMenu;
        VAR
            finalTicks : LongInt;
    BEGIN
        HiliteMenu(HiWord(selection));
        Delay(32, finalTicks);
        CASE HiWord(selection) OF
            AppleMenu :
                DoAppleMenu(LoWord(selection));
            FileMenu :
                DoFileMenu(LoWord(selection));
            EditMenu :
                DoEditMenu(LoWord(selection));
            ScaleMenu :
                DoScaleMenu(LoWord(selection));
            PenMenu :
                DoPenMenu(LoWord(selection));
            OTHERWISE
                ;
        END;
        HiliteMenu(0);
    END;

    PROCEDURE KeyEvent;
    BEGIN
        IF BitTst(@theEvent.modifiers, 7) THEN  {Check for command key}
            SelectMenu(MenuKey(theKey));
    END;

    PROCEDURE SetUpSys;
    BEGIN
        InitGraf(@thePort);
        InitFonts;
        InitWindows;
        TEInit;
        InitDialogs(NIL);
        SetDAFont(1);
        SetEventMask(everyEvent);
        FlushEvents(everyEvent, 0);
        SetUpWindow;
        SetUpMenus;
        SetDefaults;
        InitCursor;
        done := FALSE;
        FirstDialog := TRUE;
    END;

END.